]> git.dpolakovic.space - htcpcp-requestor/commitdiff
fix: User request is no longer doubled on server side. 1.0.1
authorDavid Polakovic
Mon, 2 Nov 2026 09:18:03 +0000 (10:18 +0100)
committerDavid Polakovic
Mon, 2 Nov 2026 09:18:03 +0000 (10:18 +0100)
get-coffee-from

index 5f31407bff2acf1221acf398c7e4bb60dcb3557c..6901c33e9d6a255b00b2d9b56fad3303331f2bbf 100644 (file)
@@ -4,37 +4,13 @@ use warnings;
 use LWP::UserAgent;
 use HTTP::Request;
 
-# curl -I behaviour: sends HEAD request, returns code
-sub head_code {
-    my ($url) = @_;
-
-    my $ua  = LWP::UserAgent->new(max_redirect => 0);
-    my $req = HTTP::Request->new('HEAD' => $url);
-    my $res = $ua->request($req);
-
-    return $res->code;
-}
-
-# curl -X behaviour: sends request with specified method, returns code
-sub request_code {
-    my ($method, $url) = @_;
-
-    my $ua  = LWP::UserAgent->new(max_redirect => 0);
-    my $req = HTTP::Request->new(uc($method) => $url);
-    my $res = $ua->request($req);
-
-    return $res->code;
-}
-
-# curl -X behaviour: sends request with specified method, returns body
-sub request_body {
+# curl -X behaviour: sends request with specified method, returns the full response
+sub do_request {
     my ($method, $url) = @_;
 
     my $ua  = LWP::UserAgent->new(max_redirect => 0, timeout => 10);
     my $req = HTTP::Request->new(uc($method) => $url);
-    my $res = $ua->request($req);
-
-    return $res->content;
+    return $ua->request($req);
 }
 
 sub teapot {
@@ -47,7 +23,7 @@ sub teapot {
 sub find_webmaster_email {
     my ($url) = @_;
 
-    my $body = request_body('GET', $url);
+    my $body = do_request('GET', $url)->content;
     return undef unless $body;
 
     if ($body =~ /mailto:([a-zA-Z0-9._%+\-]+\@[a-zA-Z0-9.\-]+\.[a-zA-Z]{2,})/i) { return $1 }
@@ -76,6 +52,19 @@ sub no_coffee {
     }
 }
 
+sub good_manners {
+    my ($domain) = @_;
+
+    print "Your coffee is served. It's a good manner to refill the beans for others.\n";
+    print "Do you want to refill them now? (y/n)";
+    chomp(my $answer = <STDIN>);
+
+    if (lc($answer) eq 'y') {
+        do_request('POST', $domain);
+        print "\nBeans refilled. The pot is ready for the next brew.\n";
+    }
+}
+
 ## meat
 
 # get the domain
@@ -97,10 +86,10 @@ if ($arg =~ /[^a-zA-Z0-9.\/:]/) {
     die "error: This isn't valid url.\n";
 }
 
-# check if user put www or not 
+# check if user put www or not
 if ($arg !~ /^www\./) {
     my $dot_count = () = $arg =~ /\./g;
-    
+
     # ignore for subdomains
     if ($dot_count < 2) {
         $arg = "www." . $arg;
@@ -110,52 +99,42 @@ if ($arg !~ /^www\./) {
 my $http_domain  = "http://"  . $arg;
 my $https_domain = "https://" . $arg;
 
-my $http_brew  = request_code('BREW', $http_domain);
-my $https_brew = request_code('BREW', $https_domain);
-my $http_tea   = head_code($http_domain . "/teapot");
-my $https_tea  = head_code($https_domain . "/teapot");
+# decision tree: one BREW per scheme, stop as soon as one works
+my $teapot_seen = 0;
 
-sub good_manners {
-    my ($protocol) = @_;
-
-    print "Your coffee is served. It's a good manner to refill the beans for others.\n";
-    print "Do you want to refill them now? (y/n)";
-    chomp(my $answer = <STDIN>);
+for my $domain ($http_domain, $https_domain) {
+    my $res = do_request('BREW', $domain);
 
-    if (lc($answer) eq 'y') {
-        if ($protocol eq 'http') {
-        request_code('POST', $http_domain);
-        print "\nBeans refilled. The pot is ready for the next brew.\n";
-        }
-        if ($protocol eq 'https') {
-        request_code('POST', $https_domain);
-        print "\nBeans refilled. The pot is ready for the next brew.\n";
-        }
+    if ($res->code == 200) {
+        print $res->content, "\n";
+        good_manners($domain);
+        exit;
     }
+    $teapot_seen = 1 if $res->code == 418;
 }
 
-# decision tree
-if ($http_brew == 200) {
-    print request_body('BREW', $http_domain);print "\n";
-    good_manners('http');
-} elsif ($https_brew == 200) {
-    print request_body('BREW', $https_domain);print "\n";
-    good_manners('https');
-} elsif ($http_brew == 418 || $https_brew == 418) {
-    teapot();
-} elsif ($http_tea == 200 || $https_tea == 200) {
+if ($teapot_seen) {
     teapot();
-} else {
-    no_coffee();
+    exit;
 }
 
+# no BREW worked: check for a /teapot page
+for my $domain ($http_domain, $https_domain) {
+    if (do_request('HEAD', "$domain/teapot")->code == 200) {
+        teapot();
+        exit;
+    }
+}
+
+no_coffee($arg);
+
 #print "\nThank you for using the htcpcp requestor.\n";
 
 
 
 ## debuging
-# print head_code($http_domain); print "\n";
-# print request_code('BREW', $http_domain); print "\n";
+# print do_request('HEAD', $http_domain)->code;  print "\n";
+# print do_request('BREW', $http_domain)->code;  print "\n";
 
-# print head_code($https_domain); print "\n";
-# print request_code('BREW', $https_domain); print "\n";
+# print do_request('HEAD', $https_domain)->code; print "\n";
+# print do_request('BREW', $https_domain)->code; print "\n";
Copyright 2022-2026 David Polakovic. Individual project licenses are located in project root in full length.

Site generated using Gitweb. Read the documentation for JavaScript and cookie information. Additional source code available here under GPLv3 license.

Server for this subdomain is RFC 2324 compliant